perm filename XPOSE.SAI[PIX,HPM]1 blob
sn#460773 filedate 1979-07-22 generic text, type T, neo UTF8
BEGIN "XPOSE"
comment transposes a moby picture file;
REQUIRE "PIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "FILHDR.SAI[VIS,HPM]" SOURCE_FILE;
DEFINE MAXW=230000;
BEGIN
INTEGER I,J,K, INF,OUF,NLN, BPS,BPD;
INTEGER ARRAY IHD[0:10],OHD[0:10];
DO PRINT("Input picture:") UNTIL (INF←OPNPFL(INCHWL,IHD[0]))>0;
MAKDIM(IHD[LNBY],IHD[PCLN],IHD[BYBI],OHD[0]);
PRSFIL("");
DO PRINT("Output file:") UNTIL (OUF←CREPFL(OHD[0],INCHWL))≥0;
BEGIN
INTEGER ARRAY PERM[0:IHD[BMAX]];
INTEGER ARRAY OLD,NEW[0:100];
INTEGER NUMP,FOO; STRING INP;
FOR I←1 STEP 1 UNTIL BMAX DO PERM[I]←I;
PRINT(IHD[BMAX]," is maximum grey level",
" enter piecewise linear link points",'15&'12,
" old value , new value end with a blank line",'15&'12);
NUMP←0;
WHILE LENGTH(INP←INCHWL)>0 DO
BEGIN
NUMP←NUMP+1;
OLD[NUMP]←REALSCAN(INP,FOO);
NEW[NUMP]←REALSCAN(INP,FOO);
IF OLD[NUMP]<0∨OLD[NUMP]>IHD[BMAX] THEN
BEGIN PRINT("rejected",'15&'12); NUMP←NUMP-1; END;
END;
FOR I←1 STEP 1 UNTIL NUMP-1 DO
FOR J←I+1 STEP 1 UNTIL NUMP DO
IF OLD[I]>OLD[J] THEN BEGIN OLD[I]↔OLD[J]; NEW[I]↔NEW[J]; END;
IF NUMP>0 THEN
BEGIN OLD[NUMP+1]←OLD[NUMP]; NEW[NUMP+1]←NEW[NUMP]; END;
FOR I←1 STEP 1 UNTIL NUMP DO
BEGIN
FOR J←OLD[I] STEP 1 UNTIL OLD[I+1] DO
PERM[J]←(NEW[I+1]*(J-OLD[I])+NEW[I]*(OLD[I+1]-J+1))
%(OLD[I+1]+1-OLD[I]);
END;
NLN←((MAXW-IHD[LNWD]) % OHD[LNWD]) MAX 1;
PRINT((OHD[PCLN]-1)%NLN+1," sections",'15&'12);
FOR I←0 STEP 1 UNTIL (OHD[PCLN]-1)%NLN DO
BEGIN
INTEGER ARRAY OLN[1:NLN,1:OHD[LNWD]], ILN[0:IHD[LNWD]];
PRINT(" ",I);
USETI(INF,2); comment move to beginning of input file;
FOR J←1 STEP 1 UNTIL IHD[PCLN] DO
BEGIN
ARRYIN(INF,ILN[1],IHD[LNWD]); comment read in a scanline;
BPS←POINT(IHD[BYBI],ILN[1+(I*NLN-1)%IHD[WDBY]],
((I*NLN-1) MOD IHD[WDBY])*IHD[BYBI]+IHD[BYBI]-1);
BPD←POINT(OHD[BYBI],OLN[1,1+(OHD[LNBY]-J)%OHD[WDBY]],
((OHD[LNBY]-J) MOD OHD[WDBY])*OHD[BYBI]+OHD[BYBI]-1);
FOR K←I*NLN STEP 1 UNTIL (I*NLN+NLN-1) MIN (IHD[LNBY]-1) DO
BEGIN DPB(PERM[ILDB(BPS)],BPD); BPD←BPD+OHD[LNWD]; END;
END;
J←0;
PRINT(" writing ",I*NLN," thru ",(I*NLN+NLN-1) MIN (IHD[LNBY]-1),'15&'12);
FOR K←I*NLN STEP 1 UNTIL (I*NLN+NLN-1) MIN (IHD[LNBY]-1) DO
ARRYOUT(OUF,OLN[J←J+1,1],OHD[LNWD]);
END;
RELEASE(OUF);
RELEASE(INF);
END;
END;
END "XPOSE";